home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 26 / AACD 26.iso / AACD / Programming / AllPlaton / LOM / LOMGfxMaker.AMOS / LOMGfxMaker.amosSourceCode
Encoding:
AMOS Source Code  |  1996-02-20  |  36.7 KB  |  1,503 lines
  1. ' *************************************
  2. ' *                                   *
  3. ' *          LOMGfxMaker V1.0         *
  4. ' *      Written by Chris Hodges      *
  5. ' *                                   *
  6. ' *************************************
  7. '
  8. Set Buffer 80
  9. If Screen<>-1 Then Screen Close 0
  10. MXFILES=200
  11. Dim FIL$(MXFILES)
  12. Dim FB(60,4),FB$(60),DIT(3,7)
  13. Global FB(),FB$()
  14. TH=8
  15. Global TH
  16. Gosub INIT
  17. Gosub MAIN
  18. End 
  19. MAIN:
  20.   Do 
  21.     Gosub EVENTLOOP
  22.     If BT=27 Then Gosub LOAIFF
  23.     If BT=29 Then Gosub LOAGEDA
  24.     If BT=30 Then Gosub SAVGEDA
  25.     Exit If BT=25 or BT=31
  26.   Loop 
  27. Return 
  28. EVENTLOOP:
  29.   OMK=MK
  30.   Screen 0
  31.   XM=X Screen(X Mouse) : YM=Y Screen(Y Mouse) : MK=Mouse Key : I$=Inkey$
  32.   If I$="" Then Multi Wait 
  33.   BT=0
  34.   If YM=0 : I$=Cup$ : End If 
  35.   If YM>84
  36.     If XM=0 : I$=Cleft$ : End If 
  37.     If XM=638 : I$=Cright$ : End If 
  38.     If YM=260 : I$=Cdown$ : End If 
  39.   Else 
  40.     If MK=1 and OMK<>1
  41.       CHKMOUSE[XM,YM,25,59]
  42.       BT=Param
  43.     End If 
  44.   End If 
  45.   If BT=26 Then Amos To Back 
  46. Return 
  47. INIT:
  48.   FIFF$="dh1:Grafik/DPaint/Picture/"
  49.   FGED$="dh1:LOM/Visuals/"
  50.   Screen Open 0,640,84,4,$8000
  51.   Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 0
  52.   Palette 0,$FFF,$AAA,$666
  53.   Colour 17,$BDF : Colour 18,$6F : Colour 19,$12
  54.   Screen Display 0,128,40,320,84
  55.   Wait Vbl 
  56.   Limit Mouse 
  57.   Gosub CREATEMAINSCREEN
  58.   Restore DITHER
  59.   For Y=0 To 7
  60.     For X=0 To 3
  61.       Read DIT(X,Y)
  62.     Next 
  63.   Next 
  64. Return 
  65. DITHER:
  66. Data $0,$8,$2,$A
  67. Data $C,$4,$E,$6
  68. Data $3,$B,$1,$9
  69. Data $E,$7,$D,$5
  70.  
  71. Data $5,$C,$E,$3
  72. Data $8,$0,$6,$A
  73. Data $D,$2,$4,$E
  74. Data $7,$B,$9,$1
  75. CREATEMAINSCREEN:
  76.   Screen 0
  77.   Gr Writing 0
  78.   Cls 0
  79.   DEFCLOWIN[25,0,0]
  80.   TEXBOX[19,0,616,10,0,"LOMGfxMaker by Chris Hodges."]
  81.   DEFSCRTBK[26,617,0]
  82.   FILBOX[0,11,639,83,0]
  83.   DEFTEX[27,4,13,84,23,"Load ILBM",1]
  84.   DEFTEX[28,4,25,84,35,"Save ILBM",1]
  85.   DEFTEX[29,4,37,84,47,"Load GEDA",1]
  86.   DEFTEX[30,4,49,84,59,"Save GEDA",1]
  87.   DEFTEX[31,4,61,84,71,"Quit",1]
  88.   DEFTEX[37,177,13,314,23,"Histogramm",1]
  89.   DEFTEX[38,177,25,314,35,"Optimize",1]
  90.   DEFTEX[39,177,37,314,47,"Reduce Colors",1]
  91.   DEFTEX[40,177,49,314,59,"Remap to Palette",1]
  92.   DEFTEX[41,177,61,314,71,"Edit Palette",1]
  93.   DEFBOX[60,4,73,635,81,0]
  94.   DEAGAD[28]
  95.   DRAPROCBAR[60,1,1]
  96. Return 
  97. LOAIFF:
  98.   FILEREQ[-1,480,160,-1,"Select an IFF-ILBM file to load", Extension_8_02F0(FIFF$), Extension_8_03E0(FIFF$),"","Load","Abort","","P"]
  99.   If Param$="" Then Return 
  100.   FIFF$=Param$
  101.   If Exist(FIFF$)=0
  102.     REQUEST["File does not exist!","Sorry."]
  103.     Return 
  104.   End If 
  105.   Trap Extension_8_0456 FIFF$,9
  106.   If Errtrap
  107.     REQUEST["Error while loading iff file!","What a pity :-("]
  108.     Return 
  109.   End If 
  110.   Gosub REACHUNKY
  111.   If CAMG and $800
  112.     REQUEST["This is a HAM picture!","Proceed"]
  113.   End If 
  114.   Screen 0
  115.   Gosub GREY
  116. Return 
  117. LOAGEDA:
  118.   FILEREQ[-1,480,160,-1,"Select an IFF-GEDA file to load", Extension_8_02F0(FGED$), Extension_8_03E0(FGED$),"","Load","Abort","","P"]
  119.   If Param$="" Then Return 
  120.   FGED$=Param$
  121.   If Exist(FGED$)=0
  122.     REQUEST["File does not exist!","Sorry."]
  123.     Return 
  124.   End If 
  125.   Trap Extension_8_0456 FGED$,9
  126.   If Errtrap
  127.     REQUEST["Error while loading file!","What a pity :-("]
  128.     Return 
  129.   End If 
  130.   ST=Start(9) : LE=Length(9)
  131.   If Leek(ST)<> Extension_8_0998("FORM") Then REQUEST["Not an IFF file!","Sorry"] : Erase 9 : Return 
  132.   If Leek(ST+8)<> Extension_8_0998("GEDA") Then REQUEST["Not an GEDA file!","Ooops!"] : Erase 9 : Return 
  133.   If Leek(ST+4)+8<>LE Then REQUEST["Mangeled IFF-FORM!","Oh no!"] : Erase 9 : Return 
  134.   AD=ST+12
  135.   Repeat 
  136.     LCH=Leek(AD+4)
  137.     CHNK=Leek(AD)
  138.     If CHNK= Extension_8_0998("GHED")
  139.       GX=Deek(AD+8)
  140.       GY=Deek(AD+10)
  141.       PL=Peek(AD+12)
  142.       PK=Peek(AD+14)
  143.       Reserve As Work 11,GX*GY+256+256*4+256*4
  144.       CST=Start(11) : BMOF=256*9
  145.       Doke CST,GX : Doke CST+2,GY
  146.       Doke CST+4,PL
  147.       Reserve As Work 10,4096
  148.       TST=Start(10)
  149.     End If 
  150.     If CHNK= Extension_8_0998("CMAP")
  151.       For A=0 To(LCH/4)-1
  152.         Loke CST+256+A*4,Leek(AD+8+A*4)
  153.       Next 
  154.     End If 
  155.     If CHNK= Extension_8_0998("CHKY")
  156.       X=0 : Y=0 : P=0 : PP=1
  157.       Copy AD+8,AD+8+LCH To CST+BMOF
  158.     End If 
  159.     If LCH and 1 Then Inc AD
  160.     Add AD,LCH+8
  161.   Until AD=>ST+LE
  162.   Screen 0
  163.   Gosub GREY
  164. Return 
  165. SAVGEDA:
  166.   FILEREQ[-1,480,160,-1,"Enter GEDA file for saving", Extension_8_02F0(FGED$), Extension_8_03E0(FGED$),"","Save","Abort","","PS"]
  167.   If Param$="" Then Return 
  168.   FGED$=Param$
  169.   Open Out 1,FGED$
  170.     A$="FORM"+ Extension_8_08D2(0)+"GEDA"+"GHED"+ Extension_8_08D2(64)
  171.     A$=A$+ Extension_8_08C4(GX)+ Extension_8_08C4(GY)+ Extension_8_08C4(8)+ Extension_8_08C4(0)
  172.     A$=A$+ Extension_8_08D2(DISPLAYID)+ Extension_8_08C4(NTSMODE)+ Extension_8_08C4(YOFFSET)
  173.     A$=A$+ Extension_8_08D2(0)+ Extension_8_08D2(0)+ Extension_8_08D2(0)+ Extension_8_08D2(0)
  174.     A$=A$+ Extension_8_08D2(0)+ Extension_8_08D2(0)+ Extension_8_08D2(0)+ Extension_8_08D2(0)
  175.     A$=A$+ Extension_8_08D2(0)+ Extension_8_08D2(0)+ Extension_8_08D2(0)+ Extension_8_08D2(0)
  176.     Print #1,A$;
  177.     A$="CMAP"+ Extension_8_08D2(256*4)
  178.     AD=CST+256
  179.     For A=0 To 255
  180.       A$=A$+ Extension_8_08D2(Leek(AD))
  181.       Add AD,4
  182.     Next 
  183.     Print #1,A$;
  184.     Print #1,"CHKY"+ Extension_8_08D2(GX*GY);
  185.     LE=GX*GY : AD=CST+BMOF
  186.     While LE
  187.       Print #1,Peek$(AD,Min(LE,10240));
  188.       Add AD,Min(LE,10240)
  189.       Add LE,-Min(LE,10240)
  190.     Wend 
  191.     P=Pof(1)
  192.     Pof(1)=4
  193.     Print #1, Extension_8_08D2(P-8);
  194.   Close 1
  195. Return 
  196. GREY:
  197.   Screen Open 1,GX,GY,16,0
  198.   Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  199.   Screen To Front 0
  200.   For A=0 To 15
  201.     Colour A,A*$111
  202.   Next 
  203.   AD=CST+BMOF
  204.   For Y=0 To GY-1
  205.     For X=0 To GX-1
  206.       C=Peek(AD+X+Y*GX)
  207.       V=Peek(CST+257+C*4)+Peek(CST+258+C*4)+Peek(CST+259+C*4)
  208.        Extension_8_0388 X,Y,Min((V+DIT(X and 3,Y and 3)*3)/48,15)
  209.     Next 
  210.   Next 
  211. Return 
  212. REACHUNKY:
  213.   ST=Start(9) : LE=Length(9)
  214.   If Leek(ST)<> Extension_8_0998("FORM") Then REQUEST["Not an IFF file!","Sorry"] : Erase 9 : Return 
  215.   If Leek(ST+8)<> Extension_8_0998("ILBM") Then REQUEST["Not an ILBM file!","Ooops!"] : Erase 9 : Return 
  216.   If Leek(ST+4)+8<>LE Then REQUEST["Mangeled IFF-FORM!","Oh no!"] : Erase 9 : Return 
  217.   AD=ST+12
  218.   Repeat 
  219.     LCH=Leek(AD+4)
  220.     CHNK=Leek(AD)
  221.     If CHNK= Extension_8_0998("BMHD")
  222.       GX=Deek(AD+8)
  223.       GY=Deek(AD+10)
  224.       PL=Peek(AD+16)
  225.       PK=Peek(AD+18)
  226.       SX=Deek(AD+24)
  227.       SY=Deek(AD+26)
  228.       Reserve As Work 11,GX*GY+256+256*4+256*4
  229.       CST=Start(11) : BMOF=256*9
  230.       Doke CST,GX : Doke CST+2,GY
  231.       Doke CST+4,PL
  232.       Reserve As Work 10,4096
  233.       TST=Start(10)
  234.     End If 
  235. '    If CHNK=Asc.l("CAMG") 
  236. '      CAMG=Leek(AD+8) 
  237. '      Print Hex$(CAMG,8)
  238. '      Loke CST+8,CAMG 
  239. '    End If  
  240.     If CHNK= Extension_8_0998("CMAP")
  241.       For A=0 To(LCH/3)-1
  242.         RED=Peek(AD+8+A*3)
  243.         GRN=Peek(AD+9+A*3)
  244.         BLU=Peek(AD+10+A*3)
  245.         Poke CST+257+A*4,RED
  246.         Poke CST+258+A*4,GRN
  247.         Poke CST+259+A*4,BLU
  248.       Next 
  249.     End If 
  250.     If CHNK= Extension_8_0998("BODY")
  251.       X=0 : Y=0 : P=0 : PP=1
  252.       If PK
  253.         POS=AD+8
  254.         Repeat 
  255.           CON=Peek(POS) : Inc POS
  256.           If CON<128
  257.             For A=0 To CON
  258.               B=Peek(POS) : Gosub BYTEPUT
  259.               Inc POS
  260.             Next 
  261.           End If 
  262.           If CON>128
  263.             B=Peek(POS) : Inc POS
  264.             For A=0 To 256-CON
  265.               Gosub BYTEPUT
  266.             Next 
  267.           End If 
  268.         Until POS=>AD+8+LCH
  269.         If Y<>SY : FAIL=1 : End If 
  270.       Else 
  271.         For A=0 To LCH-1
  272.           B=Peek(AD+8+A)
  273.           Gosub BYTEPUT
  274.         Next 
  275.       End If 
  276.     End If 
  277.     If LCH and 1 Then Inc AD
  278.     Add AD,LCH+8
  279.   Until AD=>ST+LE
  280. Return 
  281. BYTEPUT:
  282.   If Y=>GY Then FAIL=1 : Y=0
  283.   Poke TST,B : Inc TST
  284.   Add X,8 : If(X and $FFF8)=>GX Then Inc P : X=0 : TST=Start(10)+P*512
  285.   If P=>PL
  286.     AA=CST+BMOF+Y*GX
  287.     TST=Start(10)
  288.     For X=0 To(GX/8)-1
  289.       P2C[TST+X,AA+X*8]
  290.     Next 
  291.     DRAPROCBAR[60,Y,GY]
  292.     X=0 : Inc Y : P=0 : PP=1
  293.   End If 
  294. Return 
  295. KILGADS:
  296.   For A=25 To 60
  297.     DISGAD[A]
  298.   Next 
  299. Return 
  300. 'Procedure P2C[PLBUF,CHKBUF] 
  301. '
  302. 'End Proc
  303. Procedure P2C[PLBUF,CHKBUF]
  304.    ' COMPILED PROCEDURE -- can't convert this to AMOS code
  305. End Proc
  306.  
  307. Procedure CLRUNDO
  308.   Shared UNDOST,REDOST
  309.   Reserve As Work 14,20480
  310.   UNDOST=Start(14)+8
  311.   Loke UNDOST-8,UNDOST+8
  312.   Loke UNDOST-4,Start(14)+Length(14)-256
  313.   Doke UNDOST,-2 : Doke UNDOST+2,-2 : Doke UNDOST+4,-2 : Doke UNDOST+6,-2
  314.   Reserve As Work 13,20480
  315.   REDOST=Start(13)+8
  316.   Loke REDOST-8,REDOST+8
  317.   Loke REDOST-4,Start(13)+Length(13)-256
  318.   Doke REDOST,-2 : Doke REDOST+2,-2 : Doke REDOST+4,-2 : Doke REDOST+6,-2
  319. End Proc
  320. Procedure NEWUNDO
  321.   Shared UNDOST,REDOST
  322.   UNDO=Leek(UNDOST-8)
  323.   If Extension_8_0BE4(UNDO-2)<>-1
  324.     Loke UNDO,-1 : Loke UNDO+4,-1
  325.     Add UNDO,8
  326.   End If 
  327.   If UNDO=>Leek(UNDOST-4)
  328.     Copy UNDOST+520,UNDO To UNDOST+8
  329.     Loke UNDOST+8,-1 : Loke UNDOST+12,-1
  330.     Add UNDO,-512
  331.   End If 
  332.   Loke UNDOST-8,UNDO
  333.   Loke REDOST-8,REDOST+8
  334. End Proc
  335. Procedure PLTAUMO[X,Y,T]
  336.   Shared AWST,MAPST,MAPMAXX,MAPMAXY
  337.   For CW=0 To 31
  338.     AD=AWST+CW*64
  339.     For A=1 To 14
  340.       T1=Deek(AD) : T2=Deek(AD+2) : Add AD,4
  341.       Exit If T=>T1 and T<=T2 and T1<>0,2
  342.     Next 
  343.   Next 
  344.   If CW=32 Then PLT[X,Y,T] : Pop Proc
  345.   XB=X : YB=Y
  346.   Gosub PUWALL : Gosub ENVMOD
  347. Pop Proc
  348. PUWALL:
  349.   Gosub CHKWALL
  350.   TYP=F10+F01*2+F21*4+F12*8
  351.   T1=Deek(AWST+CW*64+TYP*4) : T2=Deek(AWST+CW*64+TYP*4+2)
  352.   If T1=T2
  353.     PLT[XB,YB,T1]
  354.   Else 
  355.     PLT[XB,YB,T1+Rnd(T2-T1)]
  356.   End If 
  357. Return 
  358. CHKWALL:
  359.   If YB>0
  360.     AD=XB+(YB-1)*MAPMAXX : Gosub CHKEX
  361.     F10=RE
  362.   Else 
  363.     F10=0
  364.   End If 
  365.   If XB>0
  366.     AD=(XB-1)+YB*MAPMAXX : Gosub CHKEX
  367.     F01=RE
  368.   Else 
  369.     F01=0
  370.   End If 
  371.   If XB<MAPMAXX-1
  372.     AD=(XB+1)+YB*MAPMAXX : Gosub CHKEX
  373.     F21=RE
  374.   Else 
  375.     F21=0
  376.   End If 
  377.   If YB<MAPMAXY-1
  378.     AD=XB+(YB+1)*MAPMAXX : Gosub CHKEX
  379.     F12=RE
  380.   Else 
  381.     F12=0
  382.   End If 
  383. Return 
  384. CHKEX:
  385.   T=Deek(MAPST+AD*4)
  386.   For A=0 To 15
  387.     T1=Deek(AWST+CW*64+A*4) : T2=Deek(AWST+CW*64+A*4+2)
  388.     If T=>T1 and T<=T2 Then RE=1 : Return 
  389.   Next 
  390.   RE=0
  391. Return 
  392. ENVMOD:
  393.   XG=XB : YG=YB
  394.   G10=F10 : G01=F01 : G21=F21 : G12=F12
  395.   If G10 Then XB=XG : YB=YG-1 : Gosub PUWALL
  396.   If G01 Then XB=XG-1 : YB=YG : Gosub PUWALL
  397.   If G21 Then XB=XG+1 : YB=YG : Gosub PUWALL
  398.   If G12 Then XB=XG : YB=YG+1 : Gosub PUWALL
  399.   XB=XG : YB=YG
  400. Return 
  401. End Proc
  402. Procedure PLT[X,Y,T]
  403.   Shared MAPST,MAPMAXX,UNDOST,MAPX,MAPY
  404.   AD=MAPST+(X+Y*MAPMAXX)*4
  405.   OT=Deek(AD)
  406.   If OT=T Then Pop Proc
  407.   UNDO=Leek(UNDOST-8)
  408.   Doke UNDO,X : Doke UNDO+2,Y : Doke UNDO+4,OT : Doke UNDO+6,Deek(AD+2)
  409.   Add UNDO,8
  410.   If UNDO=>Leek(UNDOST-4)
  411.     Copy UNDOST+520,UNDO To UNDOST+8
  412.     Loke UNDOST+8,-1 : Loke UNDOST+12,-1
  413.     Add UNDO,-512
  414.   End If 
  415.   Loke UNDOST-8,UNDO
  416.   Doke AD,T : Doke AD+2,0
  417.   Paste Icon(X-MAPX)*16,(Y-MAPY)*16,T+1
  418. End Proc
  419. Procedure UNDO
  420.   Shared MAPST,MAPMAXX,UNDOST,MAPX,MAPY,MO,REDOST
  421.   UNDO=Leek(UNDOST-8)
  422.   REDO=Leek(REDOST-8)
  423.   If Extension_8_0BE4(UNDO-2)=-2 Then REQUEST["No more undo.","Ok"] : Pop Proc
  424.   Screen 1
  425.   Loke REDO,-1 : Loke REDO+4,-1
  426.   Add REDO,8
  427.   While Extension_8_0BE4(UNDO-2)=>0
  428.     Add UNDO,-8
  429.     X=Deek(UNDO) : Y=Deek(UNDO+2) : T=Deek(UNDO+4) : TT=Deek(UNDO+6)
  430.     AD=MAPST+(X+Y*MAPMAXX)*4
  431.     Loke REDO,Leek(UNDO) : Loke REDO+4,Leek(AD)
  432.     Add REDO,8
  433.     Doke AD,T : Doke AD+2,TT
  434.     If MO=0
  435.       Paste Icon(X-MAPX)*16,(Y-MAPY)*16,T+1
  436.     End If 
  437.   Wend 
  438.   Add UNDO,-8
  439.   Loke UNDOST-8,UNDO
  440.   Loke REDOST-8,REDO
  441.   Screen 0
  442. End Proc
  443. Procedure REDO
  444.   Shared MAPST,MAPMAXX,UNDOST,MAPX,MAPY,MO,REDOST
  445.   UNDO=Leek(UNDOST-8)
  446.   REDO=Leek(REDOST-8)
  447.   If Extension_8_0BE4(REDO-2)=-2 Then REQUEST["No more redo.","Ok"] : Pop Proc
  448.   Screen 1
  449.   Loke UNDO,-1 : Loke UNDO+4,-1
  450.   Add UNDO,8
  451.   While Extension_8_0BE4(REDO-2)=>0
  452.     Add REDO,-8
  453.     X=Deek(REDO) : Y=Deek(REDO+2) : T=Deek(REDO+4) : TT=Deek(REDO+6)
  454.     AD=MAPST+(X+Y*MAPMAXX)*4
  455.     Loke UNDO,Leek(REDO) : Loke UNDO+4,Leek(AD)
  456.     Add UNDO,8
  457.     Doke AD,T : Doke AD+2,TT
  458.     If MO=0
  459.       Paste Icon(X-MAPX)*16,(Y-MAPY)*16,T+1
  460.     End If 
  461.   Wend 
  462.   Add REDO,-8
  463.   Loke REDOST-8,REDO
  464.   Loke UNDOST-8,UNDO
  465.   Screen 0
  466. End Proc
  467. Procedure FILEREQNOTIFY
  468.   Shared FIL$()
  469.   FIL$(0)=""
  470. End Proc
  471. Procedure FILEREQ[SN,SX,SY,YP,T$,F$,D$,PAT$,OK$,FAIL$,FON$,OP$]
  472.   Shared FIL$(),MXFILES
  473.   OTH=TH
  474.   Gosub INIT
  475.   Gosub SETUPSCREEN
  476.   Gosub REFRESH
  477.   Multi Wait : Limit Mouse 
  478.   OMK=0 : EXA=0 : ENT=0
  479.   Do 
  480.     If Timer>25 and RDIR=1
  481.       Sort FIL$(0)
  482.       Gosub REFRESH
  483.       Timer=0
  484.     End If 
  485.     Repeat 
  486.       If RDIR Then Gosub EXAMINDIR Else Multi Wait 
  487.     Until Amos Here
  488.     XM=X Screen(X Mouse) : YM=Y Screen(Y Mouse) : MK=Mouse Key : I$=Inkey$
  489.     If MK=2 Then Gosub DEVLIST
  490.     If I$<>"" and ENT>0
  491.       STRGAD[ENT,I$]
  492.       If Param=-1
  493.         If ENT=6
  494.           F$=Mid$(FB$(6),2) : BT=4
  495.           FIL$(0)= Extension_8_08C4(FILOFF)+ Extension_8_08C4(MXNAMLEN)+RDIR$
  496.           Exit 
  497.         End If 
  498.         If ENT=7
  499.           DD$=D$
  500.           D$=Mid$(FB$(7),2)
  501.           If Exist(D$)
  502.             Gosub NEWREAD
  503.           Else 
  504.             REQUEST["Directory "+D$+" not found!","Oh sorry!"]
  505.             D$=DD$
  506.             NEWTEX[7,"{"+D$]
  507.           End If 
  508.         End If 
  509.         If ENT=8
  510.           PAT$=Mid$(FB$(8),2)
  511.           Gosub NEWREAD
  512.         End If 
  513.         ENT=0
  514.       End If 
  515.     End If 
  516.     BT=0
  517.     If MK=1 and OMK<>1
  518.       CHKMOUSE[XM,YM,1,15]
  519.       BT=Param
  520.     End If 
  521.     If BT and ENT Then NEWTEX[ENT,FB$(ENT)] : ENT=0
  522.     If BT=1 Then Gosub DRAGSCREEN
  523.     If BT=11 Then Gosub SELECT
  524.     If BT=2 or BT=4 or BT=5
  525.       If RDIR
  526.         FIL$(0)=""
  527.       Else 
  528.         FIL$(0)= Extension_8_08C4(FILOFF)+ Extension_8_08C4(MXNAMLEN)+RDIR$
  529.       End If 
  530.       Exit 
  531.     End If 
  532.     If BT=3 Then Amos To Back 
  533.     If BT>5 and BT<9 Then ENT=BT : STRGAD[BT,""]
  534.     If BT=9 Then Gosub DEVLIST
  535.     If BT=10 Then Gosub PARDIR
  536.     If BT=12 Then Gosub DRAGSLIDER
  537.     If BT=13 Then Gosub ARROWUP
  538.     If BT=14 Then Gosub ARROWDOWN
  539.     If BT=15 Then Gosub FLIPPAGE
  540.     OMK=MK
  541.   Loop 
  542.   Screen Close SN
  543.   For A=1 To 15
  544.     DISGAD[A]
  545.   Next 
  546.   If BT=4 Then A$= Extension_8_03EC(D$)+F$ Else A$=""
  547.   TH=OTH
  548.   Trap Limit Mouse 
  549. Pop Proc[A$]
  550. INIT:
  551.   If SN<0
  552.     For A=0 To 7
  553.       Trap Screen A
  554.       If Errtrap : SN=A : Exit : End If 
  555.     Next 
  556.   End If 
  557.   If T$="" Then T$="AMCAF File Selector"
  558.   If D$="" Then D$= Extension_8_03E0(Dir$)
  559.   If Instr(OP$,"P") Then PAT=1 Else PAT=0
  560.   If Instr(OP$,"R") Then FIL$(0)=""
  561.   If Instr(OP$,"D") Then DIONLY=1 Else DIONLY=0
  562.   If Instr(OP$,"Q") Then QUICK=1 Else QUICK=0
  563.   If Instr(OP$,"S") Then SAVREQ=1 Else SAVREQ=0
  564.   KICK=Deek(Leek(4)+20)
  565.   If KICK<37 Then PAT=0
  566.   SX=Max(Min((SX+15) and $FFE0,640),160)
  567.   SY=Max(Min(SY,256),96)
  568.   If YP<40 Then YP=168-SY/2
  569.   If FIL$(0)<>""
  570.     RDIR$=Mid$(FIL$(0),5)
  571.     If D$<>RDIR$
  572.       FIL$(0)=""
  573.       RDIR=1 : NUMFIL=0 : FILOFF=0 : SELFIL=-1
  574.       Return 
  575.     Else 
  576.       SELFIL=-1
  577.       FILOFF= Extension_8_098C(FIL$(0))
  578.     End If 
  579.     For A=1 To MXFILES
  580.       Exit If FIL$(A)=Chr$(255)
  581.     Next 
  582.     NUMFIL=A-1
  583.     MXNAMLEN= Extension_8_098C(Mid$(FIL$(0),3))
  584.     RDIR=0
  585.   Else 
  586.     RDIR=1 : NUMFIL=0 : FILOFF=0 : SELFIL=-1
  587.     MXNAMLEN=0
  588.   End If 
  589. Return 
  590. SETUPSCREEN:
  591.   Screen Open SN,SX,SY,4,$8000
  592.   Curs Off : Flash Off : Paper 2 : Pen 1 : Cls 0
  593.   Palette 0,$FFF,$AAA,$666
  594.   Colour 17,$BDF : Colour 18,$6F : Colour 19,$12
  595.   Screen Display SN,288-SX/4,YP,SX,SY
  596.   If FON$<>""
  597.     A=Val(Left$(FON$,2))
  598.     If A>0
  599.       Trap Extension_8_05B0 Mid$(FON$,3),A
  600.       If Errtrap=0
  601.         TH=A
  602.       End If 
  603.     End If 
  604.   End If 
  605.   Gr Writing 0
  606.   DEFCLOWIN[2,0,0]
  607.   FILBOX[0,TH+3,SX-1,SY-1,0]
  608.   DEFTEX[1,19,0,SX-24,TH+2,"{"+T$,3]
  609.   DEFSCRTBK[3,SX-23,0]
  610.   A=Text Length("Pattern:")+8
  611.   If DIONLY=0
  612.     DEFTEX[6,A,SY-TH*2-9,SX-5,SY-TH-7,"{"+F$,7]
  613.     TEX[4,FB(6,1),FB(6,0),FB(6,3),"}File:"]
  614.     FY2=SY-TH*3-13
  615.   Else 
  616.     FY2=SY-TH*2-9
  617.   End If 
  618.   DEFTEX[7,A,FY2,SX-5,FY2+TH+2,"{"+D$,7]
  619.   TEX[4,FB(7,1),FB(7,0),FB(7,3),"}Dir:"]
  620.   If PAT
  621.     DEFTEX[8,A,FY2-TH-4,SX-5,FY2-2,"{"+PAT$,7]
  622.     TEX[4,FB(8,1),FB(8,0),FB(8,3),"}Pattern:"]
  623.     FY2=FB(8,1)-2
  624.   Else 
  625.     FY2=FB(7,1)-2
  626.   End If 
  627.   DEFTEX[4,4,SY-TH-5,SX/4-2,SY-3,OK$,1]
  628.   DEFTEX[9,SX/4+1,SY-TH-5,SX/2-3,SY-3,"Devices",1]
  629.   DEFTEX[10,SX/2,SY-TH-5,SX/2+SX/4-4,SY-3,"Parent",1]
  630.   If Right$(D$,1)=":" Then DEAGAD[10]
  631.   DEFTEX[5,SX/2+SX/4-1,SY-TH-5,SX-5,SY-3,FAIL$,1]
  632.   DEFARROWU[13,SX-22,FY2-17]
  633.   DEFARROWD[14,SX-22,FY2-8]
  634.   D=(FY2-TH-9)
  635.   MXLIN=D/TH
  636.   FY1=TH+7+(D-TH*MXLIN)/2
  637.   DEFBOX[15,SX-22,TH+5,SX-5,FY2-18,3]
  638.   DRASLIDER[15,FILOFF,MXLIN,NUMFIL,12]
  639. Return 
  640. PARDIR:
  641.   If Right$(D$,1)=":" Then Return 
  642.   If RDIR Then Extension_8_0660 
  643.   D$= Extension_8_03E0(D$)
  644.   Gosub NEWREAD
  645. Return 
  646. NEWREAD:
  647.   If RDIR Then Extension_8_0660 
  648.   NEWTEX[7,"{"+D$]
  649.   EXA=0 : RDIR=1 : Gosub EXAMINDIR
  650.   If Right$(D$,1)=":" Then DEAGAD[10] Else ACTGAD[10]
  651.   ACTGAD[9]
  652. Return 
  653. DEVLIST:
  654.   If RDIR=1 or Left$(FIL$(NUMFIL),1)=>"A" Then Return 
  655.   FILOFF=NUMFIL
  656.   F$=Dev First$("")
  657.   While NUMFIL<MXFILES and(F$<>"")
  658.     F$=Mid$(F$,2,Instr(F$,":")-1)
  659.     TYP= Extension_8_02D0(F$)
  660.     If TYP=0
  661.       MXNAMLEN=Max(MXNAMLEN,Len(F$))
  662.       Request Off 
  663.       Trap Extension_8_0672 F$
  664.       A=Errtrap
  665.       Request On 
  666.       If A=0
  667.         NAM$= Extension_8_06D8 
  668.         SOR$="A"+Upper$(F$)+Chr$(0)+"  <Dev> "+F$+Chr$(0)+" ("+NAM$+") "
  669.       Else 
  670.         SOR$="A"+Upper$(F$)+Chr$(0)+"  <Dev> "+F$+Chr$(0)+" "+ Extension_8_0522( Extension_8_0532 )
  671.       End If 
  672.       Inc NUMFIL
  673.       FIL$(NUMFIL)=SOR$
  674.     End If 
  675.     If TYP=1
  676.       MXNAMLEN=Max(MXNAMLEN,Len(F$))
  677.       Inc NUMFIL
  678.       FIL$(NUMFIL)="B"+Upper$(F$)+Chr$(0)+"  <Dir> "+F$+Chr$(0)+" Assign"
  679.     End If 
  680.     F$=Dev Next$
  681.   Wend 
  682.   Sort FIL$(0)
  683.   FILOFF=Min(FILOFF,NUMFIL-MXLIN)
  684.   Gosub REFRESH
  685.   DEAGAD[9]
  686. Return 
  687. SELECT:
  688.   Y=YM-FY1
  689.   If Y<0 or Y>=FY1+MXLIN*TH Then Return 
  690.   F=Y/TH+FILOFF+1
  691.   If F>NUMFIL Then Return 
  692.   TYP=Asc(FIL$(F))
  693.   A$=Peek$(Varptr(FIL$(F))+Instr(FIL$(F),Chr$(0))+8,40,Chr$(0))
  694.   If TYP=32
  695.     D$= Extension_8_03EC(D$)+A$
  696.     Gosub NEWREAD
  697.   End If 
  698.   If TYP=45
  699.     F$=A$
  700.     NEWTEX[6,"{"+F$]
  701.     If SELFIL<>F
  702.       If SELFIL-FILOFF=>0 and SELFIL-FILOFF<=MXLIN
  703.         A=SELFIL-FILOFF-1 : SELFIL=-1
  704.         Gosub LISTFILE
  705.       End If 
  706.       SELFIL=F : A=SELFIL-FILOFF-1 : Timer=0
  707.       Gosub LISTFILE
  708.     Else 
  709.       If Timer<50 and SAVREQ=0
  710.         BT=4
  711.       End If 
  712.     End If 
  713.   End If 
  714.   If TYP=65 or TYP=66
  715.     D$=A$ : Gosub NEWREAD
  716.   End If 
  717. Return 
  718. DRAGSCREEN:
  719.   PUSHGAD[BT]
  720.   A=YM
  721.   Limit Mouse X Hard(0),40+A To X Hard(SX-1),296-SY+A
  722.   Repeat 
  723.     If RDIR : Gosub EXAMINDIR : Else Multi Wait : End If 
  724.     YM=Y Screen(Y Mouse)-A : MK=Mouse Key : I$=Inkey$
  725.     Add YP,YM
  726.     Screen Display SN,,YP,,
  727.   Until MK<>1
  728.   Multi Wait : Limit Mouse 
  729.   OMK=1
  730.   RELEGAD[BT]
  731. Return 
  732. ARROWUP:
  733.   PUSHGAD[BT]
  734.   Repeat 
  735.     Multi Wait 
  736.     MK=Mouse Key : I$=Inkey$
  737.     If FILOFF>0
  738.       Dec FILOFF
  739.       Gosub SCROLFILES
  740.     End If 
  741.   Until MK<>1
  742.   RELEGAD[BT]
  743. Return 
  744. ARROWDOWN:
  745.   PUSHGAD[BT]
  746.   Repeat 
  747.     Multi Wait 
  748.     MK=Mouse Key : I$=Inkey$
  749.     If FILOFF<NUMFIL-MXLIN
  750.       Inc FILOFF
  751.       Gosub SCROLFILES
  752.     End If 
  753.   Until MK<>1
  754.   RELEGAD[BT]
  755. Return 
  756. DRAGSLIDER:
  757.   DISGAD[12]
  758.   O=YM-FB(12,1)
  759.   Repeat 
  760.     Multi Wait 
  761.     XM=X Screen(X Mouse) : YM=Y Screen(Y Mouse) : MK=Mouse Key : I$=Inkey$
  762.     DRAGSLIDER[15,YM-O,MXLIN,NUMFIL,12]
  763.     If NUMFIL>MXLIN
  764.       FILOFF=Param
  765.       Gosub SCROLFILES
  766.     End If 
  767.   Until MK<>1
  768.   ENAGAD[12]
  769.   DRASLIDER[15,FILOFF,MXLIN,NUMFIL,12]
  770.   OMK=1
  771. Return 
  772. REFRESH:
  773.   DEFBOX[11,4,TH+5,SX-25,FY2,7]
  774.   If NUMFIL>0
  775.     For A=0 To Min(MXLIN-1,NUMFIL-1)
  776.       Gosub LISTFILE
  777.     Next 
  778.     OLDOFF=FILOFF
  779.   End If 
  780.   If FB(12,4) and 1 Then DRASLIDER[15,FILOFF,MXLIN,NUMFIL,12]
  781. Return 
  782. SCROLFILES:
  783.   If OLDOFF=FILOFF Then Return 
  784.   X1=FB(11,0)+2 : X2=FB(11,2)-2 : Y1=FY1+1 : Y2=FY1+TH*MXLIN+1
  785.   D=FILOFF-OLDOFF
  786.   If Abs(D)>MXLIN-2 Then Gosub REFRESH : Return 
  787.   If D>0
  788.     Screen Copy SN,X1,Y1+D*TH,X2,Y2 To SN,X1,Y1
  789.     For A=MXLIN-D To MXLIN-1
  790.       Gosub LISTFILE
  791.     Next 
  792.   Else 
  793.     Screen Copy SN,X1,Y1,X2,Y2+D*TH To SN,X1,Y1-D*TH
  794.     For A=0 To -D-1
  795.       Gosub LISTFILE
  796.     Next 
  797.   End If 
  798.   OLDOFF=FILOFF
  799.   If FB(12,4) and 1 Then DRASLIDER[15,FILOFF,MXLIN,NUMFIL,12]
  800. Return 
  801. FLIPPAGE:
  802.   If NUMFIL<MXLIN Then Return 
  803.   If YM>(FB(12,1)+FB(12,3))/2
  804.     FILOFF=Min(FILOFF+MXLIN,NUMFIL-MXLIN)
  805.   Else 
  806.     FILOFF=Max(FILOFF-MXLIN,0)
  807.   End If 
  808.   Gosub REFRESH
  809.   DRASLIDER[15,FILOFF,MXLIN,NUMFIL,12]
  810. Return 
  811. LISTFILE:
  812.   If QUICK
  813.     A$=FIL$(A+FILOFF+1)
  814.     A$=Peek$(Varptr(A$)+Instr(A$,Chr$(0)),40,Chr$(0))
  815.   Else 
  816.     A$=FIL$(A+FILOFF+1)
  817.     B$=Mid$(A$,Instr(A$,Chr$(0))+1)
  818.     FIL$=Left$(B$,Instr(B$,Chr$(0))-1)
  819.     RES$=Mid$(B$,Len(FIL$)+2)
  820.     A$=FIL$+Space$(MXNAMLEN-(Len(FIL$)-8))+RES$
  821.   End If 
  822.   If Asc(FIL$(A+FILOFF+1))<>45
  823.     TEX2[6,FY1+A*TH,SX-28,FY1+(A+1)*TH+1,"{"+A$]
  824.   Else 
  825.     TEX[6,FY1+A*TH,SX-28,FY1+(A+1)*TH+1,"{"+A$]
  826.   End If 
  827.   If A+FILOFF+1=SELFIL
  828.     Gr Writing 2
  829.     Ink 2 : Bar 8,FY1+A*TH+1 To SX-29,FY1+(A+1)*TH
  830.     Gr Writing 0
  831.   End If 
  832. Return 
  833. EXAMINDIR:
  834.   If EXA=0
  835.     FILOFF=0 : NUMFIL=0 : MXNAMLEN=5 : RDIR$=D$
  836.     SELFIL=-1
  837.     For A=1 To MXFILES
  838.       FIL$(A)=Chr$(255)
  839.     Next 
  840.     Trap Extension_8_063A D$
  841.     If Errtrap=0
  842.       EXA=1 : Timer=0
  843.     Else 
  844.       Gosub REFRESH
  845.       REQUEST[ Extension_8_0522( Extension_8_0532 )+"!","Cancel"]
  846.       RDIR=0 : Return 
  847.     End If 
  848.   End If 
  849.   If NUMFIL=MXFILES
  850.      Extension_8_0660 
  851.     Sort FIL$(0)
  852.     RDIR=0
  853.     Gosub REFRESH
  854.     Return 
  855.   End If 
  856.   FIL$= Extension_8_064C 
  857.   If FIL$=""
  858.     Sort FIL$(0)
  859.     Timer=0 : RDIR=0 : Gosub REFRESH
  860.     Return 
  861.   End If 
  862.   TYP= Extension_8_0688 
  863.   If QUICK=0
  864.     DATE$=Mid$( Extension_8_0F0A( Extension_8_06F4 ),4)+" "+ Extension_8_0F1A( Extension_8_070E )
  865.     COM$= Extension_8_0762 
  866.     FLAG$= Extension_8_0728( Extension_8_0742 )
  867.   End If 
  868.   If TYP<0
  869.     If DIONLY=0
  870.       If KICK>36
  871.         A= Extension_8_0300(FIL$,PAT$)
  872.       Else 
  873.         A=-1
  874.       End If 
  875.     Else 
  876.       A=0
  877.     End If 
  878.     If A
  879.       MXNAMLEN=Max(MXNAMLEN,Len(FIL$))
  880.       SIZE$= Extension_8_0EC8( Extension_8_06A2 ,7)
  881.       Inc NUMFIL
  882.       If QUICK
  883.         FIL$(NUMFIL)="-"+Upper$(FIL$)+Chr$(0)+SIZE$+" "+FIL$+Chr$(0)
  884.       Else 
  885.         SOR$="-"+Upper$(FIL$)+Chr$(0)+SIZE$+" "+FIL$+Chr$(0)+DATE$+" "+FLAG$+" "+COM$
  886.         FIL$(NUMFIL)=SOR$
  887.       End If 
  888.     End If 
  889.   Else 
  890.     MXNAMLEN=Max(MXNAMLEN,Len(FIL$))
  891.     Inc NUMFIL
  892.     If QUICK
  893.       FIL$(NUMFIL)=" "+Upper$(FIL$)+Chr$(0)+"  <Dir> "+FIL$+Chr$(0)
  894.     Else 
  895.       SOR$=" "+Upper$(FIL$)+Chr$(0)+"  <Dir> "+FIL$+Chr$(0)+DATE$+" "+FLAG$+" "+COM$
  896.       FIL$(NUMFIL)=SOR$
  897.     End If 
  898.   End If 
  899. Return 
  900. End Proc
  901. Procedure REQUEST[T$,OP$]
  902.   Dim LIN$(20)
  903.   OPT=1 : OTH=TH
  904.   For A=1 To Len(OP$)
  905.     If Mid$(OP$,A,1)="|" Then Inc OPT
  906.   Next 
  907.   If Screen=-1
  908.     TH=8
  909.     SX=Max(Len(OP$)*8+OPT*32+8+15,320) and $FE0
  910.     LPR=SX/8-2
  911.   Else 
  912.     SX=Max(Text Length(OP$)+OPT*32+8+15,320) and $FE0
  913.     LPR=SX/Text Length("M")-2
  914.   End If 
  915.   LI=0 : LP=1 : LILE=0
  916.   For A=1 To Len(T$)
  917.     P=Asc(Mid$(T$,A,1))
  918.     Inc LILE
  919.     If LILE>LPR
  920.       LIN$(LI)=Mid$(T$,LP,SP-LP+1)
  921.       LP=SP+2 : LILE=A-LP
  922.       Inc LI
  923.     End If 
  924.     If P=32 Then SP=A-1
  925.     If P=167 Then LILE=LPR+2 : SP=A-1
  926.   Next 
  927.   LIN$(LI)=Mid$(T$,LP) : Inc LI
  928.   NBLI=LI-1
  929.   SY=32+LI*TH
  930.   If Screen=-1
  931.     SN=0
  932.     Screen Open SN,SX,SY,4,$8000
  933.     Curs Off : Flash Off : Paper 2 : Pen 1 : Cls 0
  934.     Palette 0,$FFF,$AAA,$666
  935.     Colour 17,$BDF : Colour 18,$6F : Colour 19,$12
  936.     Screen Display SN,288-SX/4,168-SY/2,SX,SY
  937.     Gr Writing 0
  938.     Wait Vbl : Limit Mouse 
  939.     OLDSCR=-1
  940.     XP=0 : YP=0
  941.   Else 
  942.     If Screen Height<SY or Screen Width<SX or Screen Colour<4
  943.       OLDSCR=Screen
  944.       For A=0 To 7
  945.         Trap Screen A
  946.         If Errtrap : SN=A : Exit : End If 
  947.       Next 
  948.       Screen Open SN,SX,SY,4,$8000
  949.       Curs Off : Flash Off : Paper 2 : Pen 1 : Cls 0
  950.       Get Palette OLDSCR
  951.       Screen Display SN,288-SX/4,168-SY/2,SX,SY
  952.       Gr Writing 0
  953.       Wait Vbl : Limit Mouse 
  954.       XP=0 : YP=0
  955.     Else 
  956.       XP=(Screen Width-SX)/2
  957.       YP=(Screen Height-SY)/2
  958.       SN=-1
  959.       Get Cblock 9,XP-4,YP-2,SX+16,SY+4
  960.       DRABOX[XP-4,YP-2,XP+SX+3,YP+SY+1,0]
  961.       DRABOX[XP-2,YP-1,XP+SX+1,YP+SY,1]
  962.       Limit Mouse X Hard(XP),Y Hard(YP) To X Hard(XP+SX-1),Y Hard(YP+SY-1)
  963.     End If 
  964.   End If 
  965.   FILBOX[XP,YP,XP+SX-1,YP+SY-1,0]
  966.   For A=0 To NBLI
  967.     TEX[XP+4,YP+4+A*TH,XP+SX-5,YP+12+A*TH,LIN$(A)]
  968.   Next 
  969.   OP=0
  970.   For A=1 To OPT
  971.     NP=Instr(OP$,"|",OP+1) : If NP=0 Then NP=Len(OP$)+1
  972.     T$=Mid$(OP$,OP+1,NP-OP-1)
  973.     X1=XP+4+((A-1)*(SX-6))/OPT
  974.     X2=XP+1+(A*(SX-6))/OPT
  975.     DEFTEX[15+A,X1,YP+SY-TH-14,X2,YP+SY-3,T$,1]
  976.     OP=NP
  977.   Next 
  978.   OMK=0
  979.   Do 
  980.     Repeat : Multi Wait : Until Amos Here
  981.     XM=X Screen(X Mouse) : YM=Y Screen(Y Mouse) : MK=Mouse Key : I$=Inkey$
  982.     BT=0
  983.     If MK=1 and OMK<>1
  984.       CHKMOUSE[XM,YM,16,15+OPT]
  985.       BT=Param
  986.     End If 
  987.     Exit If BT
  988.     OMK=MK
  989.   Loop 
  990.   For A=1 To OPT
  991.     DISGAD[15+A]
  992.   Next 
  993.   Limit Mouse 
  994.   If SN>-1
  995.     Screen Close SN
  996.     If OLDSCR>-1
  997.       Screen OLDSCR
  998.     End If 
  999.   Else 
  1000.     Put Cblock 9
  1001.     Del Cblock 9
  1002.   End If 
  1003.   TH=OTH
  1004. End Proc[BT-16]
  1005. Procedure NUMENT[T$,OP$,DEFNUM,LOWER,UPPER]
  1006.   Dim LIN$(10)
  1007.   OPT=1 : OTH=TH
  1008.   For A=1 To Len(OP$)
  1009.     If Mid$(OP$,A,1)="|" Then Inc OPT
  1010.   Next 
  1011.   If Screen=-1
  1012.     TH=8
  1013.     SX=Max(Len(OP$)*8+OPT*32+8+15,320) and $FE0
  1014.     LPR=SX/8-2
  1015.   Else 
  1016.     SX=Max(Text Length(OP$)+OPT*32+8+15,320) and $FE0
  1017.     LPR=SX/Text Length("M")-2
  1018.   End If 
  1019.   LI=0 : LP=1 : LILE=0
  1020.   For A=1 To Len(T$)
  1021.     P=Asc(Mid$(T$,A,1))
  1022.     Inc LILE
  1023.     If LILE>LPR
  1024.       LIN$(LI)=Mid$(T$,LP,SP-LP+1)
  1025.       LP=SP+2 : LILE=A-LP
  1026.       Inc LI
  1027.     End If 
  1028.     If P=32 Then SP=A-1
  1029.     If P=167 Then LILE=LPR+2 : SP=A-1
  1030.   Next 
  1031.   LIN$(LI)=Mid$(T$,LP) : Inc LI
  1032.   NBLI=LI-1
  1033.   SY=48+LI*TH
  1034.   If Screen=-1
  1035.     SN=0
  1036.     Screen Open SN,SX,SY,4,$8000
  1037.     Curs Off : Flash Off : Paper 2 : Pen 1 : Cls 0
  1038.     Palette 0,$FFF,$AAA,$666
  1039.     Colour 17,$BDF : Colour 18,$6F : Colour 19,$12
  1040.     Screen Display SN,288-SX/4,168-SY/2,SX,SY
  1041.     Gr Writing 0
  1042.     Wait Vbl : Limit Mouse 
  1043.     OLDSCR=-1
  1044.     XP=0 : YP=0
  1045.   Else 
  1046.     If Screen Height<SY or Screen Width<SX or Screen Colour<4
  1047.       For A=0 To 7
  1048.         Trap Screen A
  1049.         If Errtrap : SN=A : Exit : End If 
  1050.       Next 
  1051.       OLDSCR=Screen
  1052.       Screen Open SN,SX,SY,4,$8000
  1053.       Curs Off : Flash Off : Paper 2 : Pen 1 : Cls 0
  1054.       Get Palette OLDSCR
  1055.       Screen Display SN,288-SX/4,168-SY/2,SX,SY
  1056.       Gr Writing 0
  1057.       Wait Vbl : Limit Mouse 
  1058.       XP=0 : YP=0
  1059.     Else 
  1060.       XP=(Screen Width-SX)/2
  1061.       YP=(Screen Height-SY)/2
  1062.       SN=-1
  1063.       Get Cblock 9,XP-4,YP-2,SX+16,SY+4
  1064.       DRABOX[XP-4,YP-2,XP+SX+3,YP+SY+1,0]
  1065.       DRABOX[XP-2,YP-1,XP+SX+1,YP+SY,1]
  1066.       Limit Mouse X Hard(XP),Y Hard(YP) To X Hard(XP+SX-1),Y Hard(YP+SY-1)
  1067.     End If 
  1068.   End If 
  1069.   FILBOX[XP,YP,XP+SX-1,YP+SY-1,0]
  1070.   For A=0 To NBLI
  1071.     TEX[XP+4,YP+4+A*TH,XP+SX-5,YP+12+A*TH,LIN$(A)]
  1072.   Next 
  1073.   DEFTEX[16,XP+4,YP+SY-TH*2-18,XP+SX-5,YP+SY-TH-16,"{"+Mid$(Str$(DEFNUM),2),7]
  1074.   OP=0
  1075.   For A=1 To OPT
  1076.     NP=Instr(OP$,"|",OP+1) : If NP=0 Then NP=Len(OP$)+1
  1077.     T$=Mid$(OP$,OP+1,NP-OP-1)
  1078.     X1=XP+4+((A-1)*(SX-6))/OPT
  1079.     X2=XP+1+(A*(SX-6))/OPT
  1080.     DEFTEX[16+A,X1,YP+SY-TH-14,X2,YP+SY-3,T$,1]
  1081.     OP=NP
  1082.   Next 
  1083.   OMK=0
  1084.   STRGAD[16,""]
  1085.   Do 
  1086.     Repeat : Multi Wait : Until Amos Here
  1087.     XM=X Screen(X Mouse) : YM=Y Screen(Y Mouse) : MK=Mouse Key : I$=Inkey$
  1088.     BT=17
  1089.     If I$<>""
  1090.       If I$<" " or(I$>="0" and I$<="9")
  1091.         If Not(I$="0" and NUM=0)
  1092.           STRGAD[16,I$]
  1093.           Exit If Param=-1
  1094.         End If 
  1095.       End If 
  1096.     End If 
  1097.     NUM=Val(Mid$(FB$(16),2))
  1098.     If NUM<LOWER
  1099.       NUM=LOWER
  1100.       NEWTEX[16,"{"+Mid$(Str$(NUM),2)]
  1101.       STRGAD[16,""]
  1102.     End If 
  1103.     If NUM>UPPER
  1104.       NUM=UPPER
  1105.       NEWTEX[16,"{"+Mid$(Str$(NUM),2)]
  1106.       STRGAD[16,""]
  1107.     End If 
  1108.     BT=0
  1109.     If MK=1 and OMK<>1
  1110.       CHKMOUSE[XM,YM,16,16+OPT]
  1111.       BT=Param
  1112.     End If 
  1113.     Exit If BT>16
  1114.     OMK=MK
  1115.   Loop 
  1116.   For A=1 To OPT+1
  1117.     DISGAD[15+A]
  1118.   Next 
  1119.   Limit Mouse 
  1120.   If SN>-1
  1121.     Screen Close SN
  1122.     If OLDSCR>-1
  1123.       Screen OLDSCR
  1124.     End If 
  1125.   Else 
  1126.     Put Cblock 9
  1127.     Del Cblock 9
  1128.   End If 
  1129.   TH=OTH
  1130.   A$= Extension_8_0EB8(BT-17,1)+Mid$(Str$(NUM),2)
  1131. End Proc[A$]
  1132. Procedure TXTENT[T$,OP$,DEFTXT$,NUMLET]
  1133.   Dim LIN$(10)
  1134.   OPT=1 : OTH=TH
  1135.   For A=1 To Len(OP$)
  1136.     If Mid$(OP$,A,1)="|" Then Inc OPT
  1137.   Next 
  1138.   If Screen=-1
  1139.     TH=8
  1140.     SX=Max(Len(OP$)*8+OPT*32+8+15,320) and $FE0
  1141.     LPR=SX/8-2
  1142.   Else 
  1143.     SX=Max(Text Length(OP$)+OPT*32+8+15,320) and $FE0
  1144.     LPR=SX/Text Length("M")-2
  1145.   End If 
  1146.   LI=0 : LP=1 : LILE=0
  1147.   For A=1 To Len(T$)
  1148.     P=Asc(Mid$(T$,A,1))
  1149.     Inc LILE
  1150.     If LILE>LPR
  1151.       LIN$(LI)=Mid$(T$,LP,SP-LP+1)
  1152.       LP=SP+2 : LILE=A-LP
  1153.       Inc LI
  1154.     End If 
  1155.     If P=32 Then SP=A-1
  1156.     If P=167 Then LILE=LPR+2 : SP=A-1
  1157.   Next 
  1158.   LIN$(LI)=Mid$(T$,LP) : Inc LI
  1159.   NBLI=LI-1
  1160.   SY=48+LI*TH
  1161.   If Screen=-1
  1162.     SN=0
  1163.     Screen Open SN,SX,SY,4,$8000
  1164.     Curs Off : Flash Off : Paper 2 : Pen 1 : Cls 0
  1165.     Palette 0,$FFF,$AAA,$666
  1166.     Colour 17,$BDF : Colour 18,$6F : Colour 19,$12
  1167.     Screen Display SN,288-SX/4,168-SY/2,SX,SY
  1168.     Gr Writing 0
  1169.     Wait Vbl : Limit Mouse 
  1170.     OLDSCR=-1
  1171.     XP=0 : YP=0
  1172.   Else 
  1173.     If Screen Height<SY or Screen Width<SX or Screen Colour<4
  1174.       For A=0 To 7
  1175.         Trap Screen A
  1176.         If Errtrap : SN=A : Exit : End If 
  1177.       Next 
  1178.       OLDSCR=Screen
  1179.       Screen Open SN,SX,SY,4,$8000
  1180.       Curs Off : Flash Off : Paper 2 : Pen 1 : Cls 0
  1181.       Get Palette OLDSCR
  1182.       Screen Display SN,288-SX/4,168-SY/2,SX,SY
  1183.       Gr Writing 0
  1184.       Wait Vbl : Limit Mouse 
  1185.       XP=0 : YP=0
  1186.     Else 
  1187.       XP=(Screen Width-SX)/2
  1188.       YP=(Screen Height-SY)/2
  1189.       SN=-1
  1190.       Get Cblock 9,XP-4,YP-2,SX+16,SY+4
  1191.       DRABOX[XP-4,YP-2,XP+SX+3,YP+SY+1,0]
  1192.       DRABOX[XP-2,YP-1,XP+SX+1,YP+SY,1]
  1193.       Limit Mouse X Hard(XP),Y Hard(YP) To X Hard(XP+SX-1),Y Hard(YP+SY-1)
  1194.     End If 
  1195.   End If 
  1196.   FILBOX[XP,YP,XP+SX-1,YP+SY-1,0]
  1197.   For A=0 To NBLI
  1198.     TEX[XP+4,YP+4+A*TH,XP+SX-5,YP+12+A*TH,LIN$(A)]
  1199.   Next 
  1200.   DEFTEX[16,XP+4,YP+SY-TH*2-18,XP+SX-5,YP+SY-TH-16,"{"+DEFTXT$,7]
  1201.   OP=0
  1202.   For A=1 To OPT
  1203.     NP=Instr(OP$,"|",OP+1) : If NP=0 Then NP=Len(OP$)+1
  1204.     T$=Mid$(OP$,OP+1,NP-OP-1)
  1205.     X1=XP+4+((A-1)*(SX-6))/OPT
  1206.     X2=XP+1+(A*(SX-6))/OPT
  1207.     DEFTEX[16+A,X1,YP+SY-TH-14,X2,YP+SY-3,T$,1]
  1208.     OP=NP
  1209.   Next 
  1210.   OMK=0
  1211.   STRGAD[16,""]
  1212.   Do 
  1213.     Repeat : Multi Wait : Until Amos Here
  1214.     XM=X Screen(X Mouse) : YM=Y Screen(Y Mouse) : MK=Mouse Key : I$=Inkey$
  1215.     BT=17
  1216.     If I$<>""
  1217.       STRGAD[16,I$]
  1218.       Exit If Param=-1
  1219.     End If 
  1220.     TXT$=Mid$(FB$(16),2)
  1221.     If Len(TXT$)>NUMLET
  1222.       NEWTEX[16,"{"+Left$(TXT$,NUMLET)]
  1223.       STRGAD[16,""]
  1224.     End If 
  1225.     BT=0
  1226.     If MK=1 and OMK<>1
  1227.       CHKMOUSE[XM,YM,16,16+OPT]
  1228.       BT=Param
  1229.     End If 
  1230.     Exit If BT>16
  1231.     OMK=MK
  1232.   Loop 
  1233.   For A=1 To OPT+1
  1234.     DISGAD[15+A]
  1235.   Next 
  1236.   Limit Mouse 
  1237.   If SN>-1
  1238.     Screen Close SN
  1239.     If OLDSCR>-1
  1240.       Screen OLDSCR
  1241.     End If 
  1242.   Else 
  1243.     Put Cblock 9
  1244.     Del Cblock 9
  1245.   End If 
  1246.   TH=OTH
  1247.   A$= Extension_8_0EB8(BT-17,1)+TXT$
  1248. End Proc[A$]
  1249. Procedure CHKMOUSE[XM,YM,LL,UL]
  1250.   For BT=LL To UL
  1251.     If XM=>FB(BT,0) and XM<=FB(BT,2) and YM=>FB(BT,1) and YM<=FB(BT,3) and(FB(BT,4) and 1) Then Exit 
  1252.   Next 
  1253.   If BT>UL Then Pop Proc[0]
  1254.   If FB(BT,4) and 2 Then Pop Proc[BT]
  1255.   OST=-1 : AA=0
  1256.   ST= Extension_8_093A(FB(BT,4) and 4,2)
  1257.   Repeat 
  1258.     Multi Wait 
  1259.     XM=X Screen(X Mouse) : YM=Y Screen(Y Mouse) : MK=Mouse Key : I$=Inkey$
  1260.     If XM=>FB(BT,0) and XM<=FB(BT,2) and YM=>FB(BT,1) and YM<=FB(BT,3) Then A=1 Else A=0
  1261.     If AA<>A Then AA=A : ST=1-ST
  1262.     If OST<>ST
  1263.       If ST
  1264.         PUSHGAD[BT]
  1265.       Else 
  1266.         RELEGAD[BT]
  1267.       End If 
  1268.       OST=ST
  1269.     End If 
  1270.   Until MK<>1
  1271.   If A=0 Then Pop Proc[0]
  1272.   If ST
  1273.     RELEGAD[BT]
  1274.   Else 
  1275.     PUSHGAD[BT]
  1276.   End If 
  1277. End Proc[BT]
  1278. Procedure DEFTEX[BT,X1,Y1,X2,Y2,T$,FL]
  1279.   TEXBOX[X1,Y1,X2,Y2, Extension_8_093A(FL and 4,2),T$]
  1280.   DEFGAD[BT,X1,Y1,X2,Y2,FL]
  1281.   FB$(BT)=T$
  1282. End Proc
  1283. Procedure DEFBOX[BT,X1,Y1,X2,Y2,FL]
  1284.   FILBOX[X1,Y1,X2,Y2, Extension_8_093A(FL and 4,2)]
  1285.   DEFGAD[BT,X1,Y1,X2,Y2,FL]
  1286. End Proc
  1287. Procedure DEFGAD[BT,X1,Y1,X2,Y2,FL]
  1288.   FB(BT,0)=X1 : FB(BT,1)=Y1
  1289.   FB(BT,2)=X2 : FB(BT,3)=Y2
  1290.   FB(BT,4)=FL
  1291.   FB$(BT)=""
  1292. End Proc
  1293. Procedure DEAGAD[BT]
  1294.   If(FB(BT,4) and 1)=0 Then Pop Proc
  1295.   FB(BT,4)=FB(BT,4) and $FE
  1296.   Set Pattern 2
  1297.   Ink 3 : Bar FB(BT,0),FB(BT,1) To FB(BT,2),FB(BT,3)
  1298.   Set Pattern 0
  1299. End Proc
  1300. Procedure ACTGAD[BT]
  1301.   If FB(BT,4) and 1 Then Pop Proc
  1302.   CLRGAD[BT]
  1303.   FB(BT,4)=FB(BT,4) or 1
  1304.   If FB$(BT)<>""
  1305.     TEXBOX[FB(BT,0),FB(BT,1),FB(BT,2),FB(BT,3), Extension_8_093A(FB(BT,4) and 4,2),FB$(BT)]
  1306.   Else 
  1307.     DRABOX[FB(BT,0),FB(BT,1),FB(BT,2),FB(BT,3), Extension_8_093A(FB(BT,4) and 4,2)]
  1308.   End If 
  1309. End Proc
  1310. Procedure DISGAD[BT]
  1311.   FB(BT,4)=FB(BT,4) and $FE
  1312. End Proc
  1313. Procedure ENAGAD[BT]
  1314.   FB(BT,4)=FB(BT,4) or 1
  1315. End Proc
  1316. Procedure CLRGAD[BT]
  1317.   FB(BT,4)=FB(BT,4) and $FE
  1318.   Ink 2 : Bar FB(BT,0),FB(BT,1) To FB(BT,2),FB(BT,3)
  1319. End Proc
  1320. Procedure PUSHGAD[BT]
  1321.   DRABOX[FB(BT,0),FB(BT,1),FB(BT,2),FB(BT,3),1]
  1322. End Proc
  1323. Procedure RELEGAD[BT]
  1324.   DRABOX[FB(BT,0),FB(BT,1),FB(BT,2),FB(BT,3),0]
  1325. End Proc
  1326. Procedure FILBOX[X1,Y1,X2,Y2,SE]
  1327.   Ink 2 : Bar X1+2,Y1+1 To X2-2,Y2-1
  1328.    Extension_8_0388 X1,Y2,2
  1329.    Extension_8_0388 X2,Y1,2
  1330.   Ink 1+SE*2 : Draw X1,Y2-1 To X1,Y1 : Draw To X2-1,Y1 : Draw X1+1,Y2-1 To X1+1,Y1
  1331.   Ink 3-SE*2 : Draw X1+1,Y2 To X2,Y2 : Draw To X2,Y1+1 : Draw X2-1,Y2 To X2-1,Y1+1
  1332. End Proc
  1333. Procedure NEWTEX[BT,T$]
  1334.   FB$(BT)=T$
  1335.   TEX[FB(BT,0)+1,FB(BT,1),FB(BT,2)-1,FB(BT,3),T$]
  1336. End Proc
  1337. Procedure TEXBOX[X1,Y1,X2,Y2,SE,T$]
  1338.   TEX[X1+1,Y1,X2-1,Y2,T$]
  1339.    Extension_8_0388 X1,Y2,2 : Extension_8_0388 X2,Y1,2
  1340.   Ink 1+SE*2 : Draw X1,Y2-1 To X1,Y1 : Draw To X2-1,Y1 : Draw X1+1,Y2-1 To X1+1,Y1
  1341.   Ink 3-SE*2 : Draw X1+1,Y2 To X2,Y2 : Draw To X2,Y1+1 : Draw X2-1,Y2 To X2-1,Y1+1
  1342. End Proc
  1343. Procedure TEX[X1,Y1,X2,Y2,T$]
  1344.   If Asc(T$)=123
  1345.     M=1 : T$=Mid$(T$,2)
  1346.   Else 
  1347.     If Asc(T$)=125
  1348.       M=2 : T$=Mid$(T$,2)
  1349.     Else 
  1350.       M=0
  1351.     End If 
  1352.   End If 
  1353.   TL=Text Length(T$)
  1354.   While TL>(X2-X1)-4
  1355.     T$=Left$(T$,Len(T$)-1)
  1356.     TL=Text Length(T$)
  1357.   Wend 
  1358.   If M=1
  1359.     X=X1+4 : Y=Y1+1
  1360.   Else 
  1361.     If M=2
  1362.       X=X2-Text Length(T$)-2 : Y=Y1+1
  1363.     Else 
  1364.       X=(X1+X2-TL)/2 : Y=(Y1+Y2-TH+2)/2
  1365.     End If 
  1366.   End If 
  1367.   If Y2>0 Then Ink 2 : Bar X1+1,Y1+1 To X2-1,Y2-1
  1368.   Ink 0 : Text X,Y+Text Base,T$
  1369. End Proc
  1370. Procedure TEX2[X1,Y1,X2,Y2,T$]
  1371.   If Asc(T$)=123
  1372.     M=1 : T$=Mid$(T$,2)
  1373.   Else 
  1374.     If Asc(T$)=125
  1375.       M=2 : T$=Mid$(T$,2)
  1376.     Else 
  1377.       M=0
  1378.     End If 
  1379.   End If 
  1380.   TL=Text Length(T$)
  1381.   While TL>(X2-X1)-4
  1382.     T$=Left$(T$,Len(T$)-1)
  1383.     TL=Text Length(T$)
  1384.   Wend 
  1385.   If M=1
  1386.     X=X1+4 : Y=Y1+1
  1387.   Else 
  1388.     If M=2
  1389.       X=X2-Text Length(T$)-2 : Y=Y1+1
  1390.     Else 
  1391.       X=(X1+X2-TL)/2 : Y=(Y1+Y2-TH+1)/2
  1392.     End If 
  1393.   End If 
  1394.   If Y2>0 Then Ink 2 : Bar X1+1,Y1+1 To X2-1,Y2-1
  1395.   Ink 1 : Text X,Y+Text Base,T$
  1396. End Proc
  1397. Procedure DRABOX[X1,Y1,X2,Y2,SE]
  1398.   Ink 1+SE*2 : Draw X1,Y2-1 To X1,Y1 : Draw To X2-1,Y1 : Draw X1+1,Y2-1 To X1+1,Y1
  1399.   Ink 3-SE*2 : Draw X1+1,Y2 To X2,Y2 : Draw To X2,Y1+1 : Draw X2-1,Y2 To X2-1,Y1+1
  1400. End Proc
  1401. Procedure STRGAD[BT,I$]
  1402.   Shared POS
  1403.   A$=FB$(BT)
  1404.   If I$=""
  1405.     POS=Len(A$)-1
  1406.   End If 
  1407.   If I$>Chr$(31) Then A$=Left$(A$,POS+1)+I$+Mid$(A$,POS+2) : Inc POS
  1408.   If I$=Chr$(8) and POS>0 Then A$=Left$(A$,POS)+Mid$(A$,POS+2) : Dec POS
  1409.   If I$=Cleft$ and POS>0 Then Dec POS
  1410.   If I$=Cright$ and POS<Len(A$)-1 Then Inc POS
  1411.   If I$=Chr$(13)
  1412.     NEWTEX[BT,A$]
  1413.     Pop Proc[-1]
  1414.   End If 
  1415.   NEWTEX[BT,A$]
  1416.   X1=FB(BT,0)+5+Text Length(Mid$(A$,2,POS)) : Y1=FB(BT,1)+1
  1417.   X2=X1+Max(Text Length(Mid$(A$,POS+2,1)),4)
  1418.   If X2<FB(BT,2)-4
  1419.     Gr Writing 2
  1420.     Ink 3 : Bar X1,Y1 To X2-1,Y1+TH-1
  1421.     Gr Writing 0
  1422.   End If 
  1423. End Proc[0]
  1424. Procedure DEFCLOWIN[BT,X,Y]
  1425.   DRACLOWIN[X,Y]
  1426.   DEFGAD[BT,X,Y,X+18,Y+TH+2,1]
  1427. End Proc
  1428. Procedure DRACLOWIN[X,Y]
  1429.   FILBOX[X,Y,X+18,Y+TH+2,0]
  1430.   Ink 0 : Box 7+X,3+Y To 11+X,Y+TH-1
  1431. End Proc
  1432. Procedure DEFSCRTBK[BT,X,Y]
  1433.   DRASCRTBK[X,Y]
  1434.   DEFGAD[BT,X,Y,X+22,Y+TH+2,1]
  1435. End Proc
  1436. Procedure DRASCRTBK[X,Y]
  1437.   FILBOX[X,Y,X+22,Y+TH+2,0]
  1438.   Ink 0 : Box 4+X,2+Y To 14+X,Y+TH/2+2
  1439.   Ink 2 : Bar 8+X,Y+TH/2 To 18+X,Y+TH
  1440.   Ink 0 : Box 8+X,Y+TH/2 To 18+X,Y+TH
  1441. End Proc
  1442. Procedure DEFARROWU[BT,X,Y]
  1443.   DRAARROWU[X,Y]
  1444.   DEFGAD[BT,X,Y,X+17,Y+8,3]
  1445. End Proc
  1446. Procedure DRAARROWU[X,Y]
  1447.   DRABOX[X,Y,X+17,Y+8,0]
  1448.    Extension_8_1016 X+4,Y+6 To X+8,Y+2,0
  1449.    Extension_8_1016 X+5,Y+6 To X+8,Y+3,0
  1450.    Extension_8_1016 X+9,Y+2 To X+13,Y+6,0
  1451.    Extension_8_1016 X+9,Y+3 To X+12,Y+6,0
  1452. End Proc
  1453. Procedure DEFARROWD[BT,X,Y]
  1454.   DRAARROWD[X,Y]
  1455.   DEFGAD[BT,X,Y,X+17,Y+8,3]
  1456. End Proc
  1457. Procedure DRAARROWD[X,Y]
  1458.   DRABOX[X,Y,X+17,Y+8,0]
  1459.    Extension_8_1016 X+4,Y+2 To X+8,Y+6,0
  1460.    Extension_8_1016 X+5,Y+2 To X+8,Y+5,0
  1461.    Extension_8_1016 X+9,Y+6 To X+13,Y+2,0
  1462.    Extension_8_1016 X+9,Y+5 To X+12,Y+2,0
  1463. End Proc
  1464. Procedure DRAPROCBAR[BT,POS,MX]
  1465.   X1=FB(BT,0)+2 : X2=FB(BT,2)-2 : Y1=FB(BT,1)+1 : Y2=FB(BT,3)-1
  1466.   DX=X2-X1
  1467.   PX=X1+(POS*DX)/MX
  1468.   If PX>X1 and PX<X2
  1469.     Ink 0 : Bar X1,Y1 To PX,Y2
  1470.     Ink 2 : Bar PX,Y1 To X2,Y2
  1471.   End If 
  1472.   If PX=X1 Then Ink 2 : Bar X1,Y1 To X2,Y2
  1473.   If PX=X2 Then Ink 0 : Bar X1,Y1 To X2,Y2
  1474. End Proc
  1475. Procedure DRASLIDER[BT,LINOFF,PAG,NUMLIN,NB]
  1476.   D=(FB(BT,3)-FB(BT,1))-4
  1477.   Y1=(LINOFF*D)/Max(NUMLIN,PAG)+FB(BT,1)+2
  1478.   Y2=((LINOFF+PAG)*D)/Max(NUMLIN,PAG)+FB(BT,1)+2
  1479.   DEFGAD[NB,FB(BT,0)+4,Y1,FB(BT,2)-4,Y2,3]
  1480.   Ink 2
  1481.   If Y1>FB(BT,1)+2 Then Bar FB(BT,0)+4,FB(BT,1)+1 To FB(BT,2)-4,Y1-1
  1482.   If Y2<FB(BT,3)-2 Then Bar FB(BT,0)+4,Y2+1 To FB(BT,2)-4,FB(BT,3)-1
  1483.   If Y2-Y1>0
  1484.     Ink 0 : Bar FB(BT,0)+4,Y1 To FB(BT,2)-4,Y2
  1485.   Else 
  1486.      Extension_8_1016 FB(BT,0)+4,Y1 To FB(BT,2)-4,Y2,0
  1487.   End If 
  1488. End Proc
  1489. Procedure DRAGSLIDER[BT,Y,PAG,NUMLIN,NB]
  1490.   Y1=FB(NB,1) : Y2=FB(NB,3) : D=Y2-Y1
  1491.   Y1=Min(Max(FB(BT,1)+2,Y),FB(BT,3)-2-D)
  1492.   Y2=Y1+D : FB(NB,1)=Y1 : FB(NB,3)=Y2
  1493.   Ink 2
  1494.   If Y1>FB(BT,1)+2 Then Bar FB(BT,0)+4,FB(BT,1)+1 To FB(BT,2)-4,Y1-1
  1495.   If Y2<FB(BT,3)-2 Then Bar FB(BT,0)+4,Y2+1 To FB(BT,2)-4,FB(BT,3)-1
  1496.   If Y2-Y1>0
  1497.     Ink 1 : Bar FB(BT,0)+4,Y1 To FB(BT,2)-4,Y2
  1498.   Else 
  1499.      Extension_8_1016 FB(BT,0)+4,Y1 To FB(BT,2)-4,Y2,1
  1500.   End If 
  1501.   D=FB(BT,3)-FB(BT,1)-4
  1502.   L=Min(((Y1-FB(BT,1)-2)*Max(NUMLIN,PAG)+D/2)/D,NUMLIN-PAG)
  1503. End Proc[L]